home *** CD-ROM | disk | FTP | other *** search
/ Software Vault: The Gold Collection / Software Vault - The Gold Collection (American Databankers) (1993).ISO / cdr05 / tpwplay.zip / MIDIPLAY.PAS < prev    next >
Pascal/Delphi Source File  |  1993-07-13  |  4KB  |  165 lines
  1. unit MidiPlay;
  2.  
  3. { 
  4.   MidiPlay                                     
  5.   Programmer: Charlie Calvert                  
  6.   Date: March 1993                             
  7.  
  8.   Copyright (c) June 1993, by Charlie Calvert
  9.   Feel free to use this code as an adjunct to your own programs.
  10.  
  11.   This unit currently has the name and path of a MIDI file
  12.   hard coded into it. Therefore, it will not play if it can't
  13.   find the path and file on your system. Obviously this means
  14.   there are features I still want to add to this unit. The
  15.   file should be installed on all Windows systems, however.
  16. }
  17.  
  18. interface
  19.  
  20. uses
  21.   MidiUnit, MMSystem, ODialogs, OWindows, PlayDlg,
  22.   PlayerId, Strings, WinDos, WinTypes, WinProcs;
  23.  
  24. const
  25.   DevType:PChar = 'Sequencer';
  26.   FileName:PChar = 'c:\windows\canyon.mid';
  27.  
  28.  
  29. type
  30.   PMidiDlg = ^TMidiDlg;
  31.   TMidiDlg = Object(TPlayDialog)
  32.       Location: LongInt;
  33.       CurTime, LenText, DevInfo: PStatic;
  34.       FileBox: PListBox;
  35.       EdCurDir: PEdit;
  36.     constructor Init(AParent: PWindowsObject; AName: PChar);
  37.     destructor Done; virtual;
  38.     procedure SetUpWindow; virtual;
  39.     procedure ReportStatus; virtual;
  40.     procedure GetDirectoryInfo(var Msg: TMessage);
  41.       virtual Wm_First + Wm_FillDir;
  42.     procedure MciNotify(var Msg: TMessage);
  43.       virtual wm_First + mm_MciNotify;
  44.     procedure MidiAbort(var Msg: TMessage);
  45.       virtual id_First + idAbort;
  46.     procedure MidiOpen(var Msg: TMessage);
  47.       virtual id_First + id_MidiOpen;
  48.     procedure MidiPause(var Msg: TMessage);
  49.       virtual id_First + id_MidiPause;
  50.     procedure MidiPlay(var Msg: TMessage);
  51.       virtual id_First + id_MidiPlay;
  52.     procedure WmTimer(var Msg: TMessage);
  53.       virtual wm_First + wm_Timer;
  54.   end;
  55.  
  56. implementation
  57.  
  58. constructor TMidiDlg.Init(AParent: PWindowsObject; AName: PChar);
  59. begin
  60.   inherited Init(AParent, AName);
  61.   CurTime := New(PStatic, InitResource(@Self, id_MidiNumTracks, MinLen));
  62.   LenText := New(PStatic, InitResource(@Self, id_MidiLenInfo, MinLen));
  63.   DevInfo := New(PStatic, InitResource(@Self, id_MidiDevInfo, MinLen));
  64.   FileBox := New(PListBox, InitResource(@Self, id_WaveList));
  65.   EdCurDir := New(PEdit, InitResource(@Self, id_WaveCurDir, MaxLen));
  66. end;
  67.  
  68. destructor TMidiDlg.Done;
  69. begin
  70.   if GetDeviceId <> 0 then CloseMci;
  71.   inherited Done;
  72. end;
  73.  
  74. procedure TMidiDlg.SetUpWindow;
  75. begin
  76.   inherited SetUpWindow;
  77.   Location := 0;
  78.   StrCopy(WildCard, '*.mid');
  79.   GetWindowsDirectory(CurrentDirectory, MaxLen);
  80.   SetCurDir(CurrentDirectory);
  81.   PostMessage(HWindow, Wm_FillDir, 0, 0);
  82. end;
  83.  
  84. procedure TMidiDlg.GetDirectoryInfo(var Msg: TMessage);
  85. var
  86.   S: array[0..15] of Char;
  87. begin
  88.   SetCurDir(CurrentDirectory);
  89.   StrCopy(S, WildCard);
  90.   if FileBox^.GetCount > 0 then FileBox^.ClearList;
  91.   SendMessage(FileBox^.HWindow, LB_DIR, DDL_ARCHIVE, LongInt(@S));
  92.   FileBox^.SetSelIndex(0);
  93.   EdCurDir^.SetText(CurrentDirectory);
  94. end;
  95.  
  96. procedure TMidiDlg.ReportStatus;
  97. begin
  98.   Mode := GetMode;
  99.   GetStatus;
  100. end;
  101.  
  102. procedure TMidiDlg.MciNotify(var Msg: TMessage);
  103. begin
  104.   KillTimer(HWindow, PlayTimer);
  105.   ReportStatus;
  106.   if Mode = Mci_Mode_Stop then CloseMci;
  107. end;
  108.  
  109. procedure TMidiDlg.MidiAbort(var Msg: TMessage);
  110. begin
  111.   StopMCI;
  112.   ReportStatus;
  113. end;
  114.  
  115. procedure TMidiDlg.MidiOpen(var Msg: TMessage);
  116. begin
  117.   OpenMci(HWindow, FileName, DevType);
  118. end;
  119.  
  120. procedure TMidiDlg.MidiPlay(var Msg: TMessage);
  121. var
  122.   Buf,
  123.   S: array[0..MinLen] of Char;
  124.   Result: LongInt;
  125. begin
  126.   Location := 0;
  127.   if Mode <> Mci_Mode_Pause then begin
  128.     if (FileBox^.GetSelString(Buf, MaxLen) < 0) then begin
  129.     MessageBox(HWindow, 'No file selected in listbox', '', mb_Ok);
  130.     exit;
  131.     end;
  132.     StrCopy(S, CurrentDirectory);
  133.     StrCat(S, '\');
  134.     StrCat(S, Buf);
  135.     OpenMci(HWindow, S, DevType);
  136.     ReportStatus;
  137.     if Mode = MidiError then exit;
  138.     CheckForMapper;
  139.     StartTimer;
  140.     SetTimeFormatMS;
  141.     Result := GetLen;
  142.     wvsPrintf(S, '%ld ms', Result);
  143.     LenText^.SetText(S);
  144.     DevInfo^.SetText(GetInfo(S));
  145.   end;
  146.   PlayMci;
  147.   ReportStatus;
  148. end;
  149.  
  150. procedure TMidiDlg.MidiPause(var Msg: TMessage);
  151. begin
  152.   PauseMidi;
  153.   ReportStatus;
  154. end;
  155.  
  156. procedure TMidiDlg.WmTimer(var Msg: TMessage);
  157. var
  158.   S: array[0..50] of Char;
  159. begin
  160.   Location := GetLocation;
  161.   Str(Location, S);
  162.   CurTime^.SetText(S);
  163.   ReportStatus;
  164. end;
  165. end.